Over 1,000 Windows 95 Programs/Over 1000 Windows 95 Programs (Microforum) (Disc 1).iso/1138/source.zip/FRMMAIN.FRM

Text File | 1995-02-14 | 38KB | 1,174 lines

VERSION 2.00
Begin Form frmmain
   BackColor       =   &H00FFFFFF&
   Caption         =   "Paperboy"
   ClientHeight    =   3804
   ClientLeft      =   1152
   ClientTop       =   1752
   ClientWidth     =   7512
   ClipControls    =   0   'False
   FontBold        =   -1  'True
   FontItalic      =   0   'False
   FontName        =   "MS Sans Serif"
   FontSize        =   12
   FontStrikethru  =   0   'False
   FontUnderline   =   0   'False
   Height          =   4548
   Icon            =   FRMMAIN.FRX:0000
   Left            =   1104
   LinkTopic       =   "Form1"
   ScaleHeight     =   3804
   ScaleWidth      =   7512
   Top             =   1056
   Width           =   7608
   Begin CommonDialog dlgFile
      CancelError     =   -1  'True
      Left            =   2880
      Top             =   720
   End
   Begin PictureBox pictext
      ClipControls    =   0   'False
      Enabled         =   0   'False
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "Book Antiqua"
      FontSize        =   13.8
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   2052
      Left            =   0
      ScaleHeight     =   2028
      ScaleWidth      =   7068
      TabIndex        =   3
      Top             =   1800
      Width           =   7092
   End
   Begin VScrollBar vsbtext
      Height          =   1932
      Left            =   7200
      TabIndex        =   2
      Top             =   1800
      Value           =   1
      Width           =   252
   End
   Begin ListBox lstsubjects
      Enabled         =   0   'False
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   7.8
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   1560
      Left            =   3600
      TabIndex        =   1
      Top             =   0
      Width           =   3852
   End
   Begin ListBox lstareas
      Enabled         =   0   'False
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   7.8
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   1560
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   2532
   End
   Begin Menu mnuFile
      Caption         =   "&File"
      Begin Menu mnuFOPEN
         Caption         =   "&Open SOUP Packet..."
         Shortcut        =   ^O
      End
      Begin Menu mnubar0
         Caption         =   "-"
      End
      Begin Menu mnunewfolder
         Caption         =   "&New Folder..."
      End
      Begin Menu mnudelfolder
         Caption         =   "&Delete Folder..."
         Enabled         =   0   'False
      End
      Begin Menu mnubar1
         Caption         =   "-"
      End
      Begin Menu mnusave
         Caption         =   "&Save/Append Message..."
         Enabled         =   0   'False
         Shortcut        =   ^S
      End
      Begin Menu mnuFPrint
         Caption         =   "&Print Message"
         Enabled         =   0   'False
         Shortcut        =   ^P
      End
      Begin Menu mnubar3
         Caption         =   "-"
      End
      Begin Menu mnuFExit
         Caption         =   "E&xit"
         Shortcut        =   ^Q
      End
   End
   Begin Menu mnuedit
      Caption         =   "&Edit"
      Begin Menu mnuECopy
         Caption         =   "&Copy Message to Clipboard"
         Enabled         =   0   'False
         Shortcut        =   ^C
      End
      Begin Menu mnucopytofolder
         Caption         =   "Copy Message to Folder..."
         Enabled         =   0   'False
         Shortcut        =   ^K
      End
      Begin Menu mnudelfromfolder
         Caption         =   "&Delete Message from Folder"
         Enabled         =   0   'False
         Shortcut        =   ^D
      End
      Begin Menu mnubar13
         Caption         =   "-"
      End
      Begin Menu mnufind
         Caption         =   "&Find..."
         Enabled         =   0   'False
         Shortcut        =   {F2}
      End
      Begin Menu mnufindnext
         Caption         =   "Find &Next"
         Enabled         =   0   'False
         Shortcut        =   {F3}
      End
      Begin Menu mnubar6
         Caption         =   "-"
      End
      Begin Menu mnurot13
         Caption         =   "&Rot 13"
         Enabled         =   0   'False
         Shortcut        =   ^X
      End
   End
   Begin Menu menumessage
      Caption         =   "&Message"
      Begin Menu mnunewmail
         Caption         =   "Send &new Mail..."
         Shortcut        =   ^N
      End
      Begin Menu mnureplymail
         Caption         =   "Reply via &mail..."
         Enabled         =   0   'False
         Shortcut        =   ^R
      End
      Begin Menu mnubar4
         Caption         =   "-"
      End
      Begin Menu mnuPostMsg
         Caption         =   "&Post new message to newsgroup..."
         Enabled         =   0   'False
         Shortcut        =   ^U
      End
      Begin Menu mnuFollowUp
         Caption         =   "Post &Followup to newsgroup..."
         Enabled         =   0   'False
         Shortcut        =   ^F
      End
      Begin Menu mnubar8
         Caption         =   "-"
      End
      Begin Menu mnuexted
         Caption         =   "Specify &Editor..."
      End
   End
   Begin Menu mnudisplay
      Caption         =   "&Display"
      Begin Menu mnufixedpitch
         Caption         =   "Fixed &Pitch"
         Shortcut        =   ^M
      End
      Begin Menu mnushowheaders
         Caption         =   "Show &Headers"
         Shortcut        =   ^H
      End
      Begin Menu mnushowlengths
         Caption         =   "Show &Lengths"
         Enabled         =   0   'False
      End
      Begin Menu mnubar9
         Caption         =   "-"
      End
      Begin Menu mnufonts
         Caption         =   "&Fonts"
         Begin Menu mnugroups
            Caption         =   "&Groups..."
         End
         Begin Menu mnusubjects
            Caption         =   "&Subjects..."
         End
         Begin Menu mnumessage
            Caption         =   "&Message Text..."
         End
         Begin Menu mnuquote
            Caption         =   "&Quoted Text..."
         End
         Begin Menu mnumonofont
            Caption         =   "Mo&nospaced Text..."
         End
      End
      Begin Menu mnuration
         Caption         =   "Screen &Ratio..."
      End
      Begin Menu mnubackground
         Caption         =   "&Background Color..."
      End
   End
   Begin Menu mnuHelp
      Caption         =   "&Help"
      Begin Menu mnuughbug
         Caption         =   "Send &Bug Report or Suggestion..."
      End
      Begin Menu mnushowdocs
         Caption         =   "Doc&umentation"
      End
      Begin Menu mnubar2
         Caption         =   "-"
      End
      Begin Menu mnuHAbout
         Caption         =   "&About..."
      End
   End
End
Option Explicit

Sub DisableMsgMenus ()
mnuFPrint.Enabled = False
mnuECopy.Enabled = False
mnureplymail.Enabled = False
mnurot13.Enabled = False
mnuFollowUp.Enabled = False
mnuPostMsg.Enabled = False
mnusave.Enabled = False
mnufixedpitch.Enabled = False
mnucopytofolder.Enabled = False
mnushowheaders.Enabled = False
mnudelfromfolder.Enabled = False
mnufind.Enabled = False
mnufindnext.Enabled = False
'mnu.Enabled = False

End Sub

Sub EnableMsgMenus ()
mnuFPrint.Enabled = True
mnuECopy.Enabled = True
mnureplymail.Enabled = True
mnurot13.Enabled = True
mnusave.Enabled = True
mnufixedpitch.Enabled = True
mnushowheaders.Enabled = True
mnucopytofolder.Enabled = True
mnufind.Enabled = True
mnufindnext.Enabled = True
If group = 0 Then
    MsgBox "Shouldn't be here", 0, "Internal Error"
    Exit Sub
End If
If IsFolder(group) Then mnudelfromfolder.Enabled = True
If Mid$(fixstr(GetAreaEncoding(group)), 3, 1) = "n" Then
    mnuFollowUp.Enabled = True
    mnuPostMsg.Enabled = True
End If
'mnu.Enabled = True

End Sub

Sub Form_Load ()
    DisableMsgMenus
    Form_resize
    Call SetBackgrounds
End Sub

Sub Form_resize ()
' Whenever form is resized, we need to scale all
' controls appropriately so they fill the new window
Dim horizpercent As Single, vertpercent As Single

    horizpercent = Val(GetINI("Window", "HPercent", Str(40)))
    vertpercent = Val(GetINI("Window", "VPercent", Str(30)))
    horizpercent = horizpercent / 100
    vertpercent = vertpercent / 100

    lstareas.Top = 0
    lstareas.Left = 0
    lstareas.Width = frmmain.ScaleWidth * horizpercent
    lstareas.Height = frmmain.ScaleHeight * vertpercent
    lstsubjects.Top = 0
    lstsubjects.Left = lstareas.Width
    lstsubjects.Height = lstareas.Height
    lstsubjects.Width = frmmain.ScaleWidth - lstareas.Width
    pictext.Left = 0
    pictext.Top = lstsubjects.Height
    pictext.Width = frmmain.ScaleWidth - vsbtext.Width
    pictext.Height = frmmain.ScaleHeight - lstsubjects.Height
    vsbtext.Left = pictext.Width
    vsbtext.Top = pictext.Top
    vsbtext.Height = pictext.Height
End Sub

Function IsQuoted (textline As String)
Dim l As String
l = Left$(textline, 1)
If l = ">" Or l = "<" Or l = ":" Or l = "|" Or l = "]" Or Left$(textline, 10) = "In article" Then IsQuoted = 1 Else IsQuoted = 0
End Function

Sub lstareas_click ()
Dim which As Integer
Dim result As Integer
Dim showlengths As Integer
Dim subj1 As String, subj2 As String, subj3 As String

    lstsubjects.Clear
    lstsubjects.Enabled = False
    If UCase$(GetINI("Display", "ShowLengths", "N")) = "N" Then
        showlengths = False
    Else
        showlengths = True
    End If
    message = 0
    pictext.Cls
    pictext.Enabled = False
    vsbtext.Enabled = False
    mnudelfolder.Enabled = False
    mnushowlengths.Enabled = True
    group = lstareas.ListIndex + 1
    DisableMsgMenus
    If group = 0 Then Exit Sub
    screen.MousePointer = hourglass
    If IsFolder(group) Then mnudelfolder.Enabled = True
    If Mid$(fixstr(GetAreaEncoding(group)), 3, 1) = "n" And Not IsFolder(group) Then
        mnuPostMsg.Enabled = True
        result = ThreadMsgs(group)
    End If

    subj1 = ""
    For which = 1 To GetNumMsgs(group)
        subj2 = fixstr(GetSubject(group, which))
        If UCase$(Left$(subj2, 4)) = "RE: " Then
            While UCase$(Left$(subj2, 4)) = "RE: "
                subj2 = Mid$(subj2, 5)
            Wend
            subj2 = ">" + subj2
        End If
        'If UCase$(Mid$(subj1, 15)) = UCase$(Mid$(subj2, 15)) Then
        '    subj2 = ">" + subj2
        'Else
        '    subj1 = subj2
        'End If

        If showlengths = True Then subj2 = "(" + Format$(GetLength(group, which) / 1024, "0.0") + "KB)" + Chr(9) + subj2

        lstsubjects.AddItem subj2
    Next which

    lstsubjects.Enabled = True
    screen.MousePointer = NORMAL
End Sub

Sub lstsubjects_Click ()
    showmessages
End Sub

Sub MakeMessage ()
    'If UCase$(GetINI("Editor", "UseExternalEditor", "Y")) = "N" Then
        'frmmail.Show 1
    'Else
        frmexted.Show 1
    'End If
End Sub

Sub mnubackground_Click ()
On Error Resume Next

    dlgfile.Flags = CC_RGBINIT 'Or CC_PREVENTFULLOPEN
    'dlgfile.Color = Val(GetINI("Display", "BackColor", Hex$(WINDOW_BACKGROUND)))
    dlgfile.DialogTitle = "Change Background Color"
    dlgfile.Action = DLG_COLOR
    If Err = 0 Then 'Didn't press cancel
        SetINI "Display", "BackColor", dlgfile.Color
        Call SetBackgrounds
    End If
End Sub

Sub mnucopytofolder_Click ()

    remember (0)
    frmfold.Show 1
    remember (1)
End Sub

Sub mnudelfolder_Click ()
Dim foldername As String
Dim whichfolder As Integer
Dim folderfile As String

    lstsubjects.Enabled = False
    If group = 0 Then Exit Sub
    foldername = fixstr(GetAreaName(group))
    If IsFolder(group) And MsgBox("Delete folder " + foldername + "?", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2, "Confirm") = IDYES Then
        ' Find folder
        whichfolder = 1
        While GetINI("Folders", "Name" + Format$(whichfolder), "") <> foldername And whichfolder <= NUMFOLDERS
            whichfolder = whichfolder + 1
        Wend
        If whichfolder > NUMFOLDERS Then
            MsgBox "Can't delete folder", 0, "Warning!"
        Else
            ' Delete the folder
            RemoveArea (foldername)
            SetINI "Folders", "Name" + Format$(whichfolder), ""
            folderfile = app.Path + "\FOLDER" + Format$(whichfolder) + ".FOL"
            Kill folderfile
            ' Reread folders
            DoFolders
            Call lstareas_click
        End If
    End If
End Sub

Sub mnudelfromfolder_Click ()
Dim result As Integer

    remember (0)
    lstsubjects.Enabled = False
    lstsubjects.Clear
    result = DeleteMsg(group, message)
    DllErr result
    DoFolders
    remember (1)
End Sub

Sub mnuECopy_Click ()
Dim lineno As Integer
Dim hold As String

    If message > 0 Then
        screen.MousePointer = hourglass
        clipboard.Clear
        hold = ""
        GetMsg group, message
        For lineno = 1 To GetNumLines()
            hold = hold + fixstr(GetLine(lineno)) + Chr(13) + Chr(10)
        Next lineno
        clipboard.SetText hold
        screen.MousePointer = default
    End If
End Sub

Sub mnuexted_Click ()
frmched.Show 1
End Sub

Sub mnuFExit_Click ()
    Dim result As Integer
    If windowstate = NORMAL Then
        ' Update size/position in INI file
        SetINI "Window", "Maximized", "N"
        SetINI "Window", "Top", Str(Int(Top))
        SetINI "Window", "Left", Str(Int(Left))
        SetINI "Window", "Height", Str(Int(Height))
        SetINI "Window", "Width", Str(Int(Width))
    Else If windowstate = MAXIMIZED Then SetINI "Window", "Maximized", "Y"
    End If

    SetINI "Fonts", "GroupsName", lstareas.FontName
    SetINI "Fonts", "GroupsSize", Str(lstareas.FontSize)
    SetINI "Fonts", "SubjName", lstsubjects.FontName
    SetINI "Fonts", "SubjSize", Str(lstsubjects.FontSize)

    frmmain.Hide     ' This should end sub main
End Sub

Sub mnufind_Click ()
Dim srchstring As String
Dim w As finder
Dim result As Integer
Dim tmpstr As String

    srchstring = GetINI("Message", "LastSearch", "word")
    srchstring = InputBox$("Enter text to search for", "Find (Experimental/Buggy)", srchstring)
    srchstring = LCase$(srchstring)
    If srchstring <> "" Then
        SetINI "Message", "LastSearch", srchstring
        w.group = lstareas.ListIndex + 1
        w.message = lstsubjects.ListIndex + 1
        'w.lineno = vsbtext.Value + 1
        w.lineno = GetNumLines()    'End of current message
        screen.MousePointer = hourglass
        result = Find(w, srchstring)
        screen.MousePointer = default
        If result = 1 Then
            lstareas.ListIndex = w.group - 1
            lstsubjects.ListIndex = w.message - 1
            mnushowheaders.Checked = True
            showmessages
            tmpstr = Str(w.group) + "," + Str(w.message) + "," + Str(w.lineno) + "out of " + Str(GetNumLines())
            'MsgBox tmpstr, 0, "Found!"
            vsbtext.Value = w.lineno + 2
            MsgBox "Line #" & Format$(w.lineno) + Chr(13) + Chr(10) + fixstr(GetLine(w.lineno)), MB_OK, "Found " & srchstring
        Else
            MsgBox "Not Found: " + srchstring, MB_ICONINFORMATION, "Paperboy Find"
        End If
    End If
End Sub

Sub mnufindnext_Click ()
Dim srchstring As String
Dim w As finder
Dim result As Integer

    srchstring = GetINI("Message", "LastSearch", "word")
    'srchstring = InputBox$("Enter text to search for", "Find", srchstring)
    srchstring = LCase$(srchstring)
    If srchstring <> "" Then
        SetINI "Message", "LastSearch", srchstring
        w.group = lstareas.ListIndex + 1
        w.message = lstsubjects.ListIndex + 1
        w.lineno = vsbtext.Value + 1
        screen.MousePointer = hourglass
        result = Find(w, srchstring)
        screen.MousePointer = default
        If result = 1 Then
            lstareas.ListIndex = w.group - 1
            lstsubjects.ListIndex = w.message - 1
            showmessages
            MsgBox "Line #" & Format$(w.lineno) + Chr(13) + Chr(10) + fixstr(GetLine(w.lineno)), MB_OK, "Found " & srchstring
            'If mnushowheaders.Checked = True Then
            '    vsbtext.Value = w.lineno - 1 + 2
            'Else
            '    vsbtext.Value = w.lineno - endofheaders() - 1 + 2
            'End If
        Else
            MsgBox "Not Found: " + srchstring, MB_ICONINFORMATION, "Paperboy Find"
        End If
    End If

End Sub

Sub mnufixedpitch_Click ()

    mnufixedpitch.Checked = Not mnufixedpitch.Checked
    If mnufixedpitch.Checked Then
        SetINI "Display", "FixedPitch", "Y"
    Else
        SetINI "Display", "FixedPitch", "N"
    End If

    showmessages
End Sub

Sub mnuFollowUp_Click ()
Dim subj As String

    remember (0)
    If fixstr(GetHeader("Followup-To")) <> "" Then
        mailsendto = fixstr(GetHeader("Followup-To"))
    Else
        mailsendto = fixstr(GetHeader("Newsgroups"))
    End If
    mailreferences = fixstr(GetHeader("Message-ID")) + " " + fixstr(GetHeader("References"))
    subj = fixstr(GetHeader("Subject"))
    If Left$(subj, 4) <> "Re: " Then subj = "Re: " & subj
    mailsubject = subj
    replytype = 2
    MakeMessage
    remember (1)
End Sub

Sub mnuFOPEN_Click ()
Dim Filename As String

    Filename = GetINI("Files", "Last SOUP Packet", app.Path + "\SAMPLE.ZIP")
    On Error Resume Next

    Err = 0
    dlgfile.Flags = OFN_FILEMUSTEXIST
    dlgfile.Filename = Filename
    dlgfile.Filter = "Soup Packet (*.ZIP)|*.ZIP|SOUP Areas File (AREAS.)|AREAS"
    dlgfile.InitDir = CurDir$
    dlgfile.DialogTitle = "Open SOUP AREAS File"
    dlgfile.Action = DLG_FILE_OPEN
    If Err = 0 Then 'Didn't press cancel
        Filename = dlgfile.Filename
        SetINI "Files", "Last SOUP Packet", Filename
        If GetINI("Files", "AREASTimestamp", "None") = FileDateTime(Filename) Then Persist = True Else Persist = False' Same packet
        SetINI "Files", "AREASTimestamp", FileDateTime(Filename)
        OpenAreas (Filename)
    End If
End Sub

Sub mnuFPrint_Click ()
Dim lineno As Integer
Dim Max As Integer
Dim subject As String
Dim author As String
Dim organization As String
Dim textline As String
Dim inquote As Integer
Dim leftmargin As String
Dim fixedpitch As Integer
Dim holdbold As Integer
Dim firstline As Integer

inquote = 0
leftmargin = " "
screen.MousePointer = hourglass

If message > 0 Then
    If mnushowheaders.Checked = True Then
        firstline = 1
    Else
        firstline = endofheaders()
    End If

    If mnufixedpitch.Checked = True Then
        fixedpitch = 1
        printer.FontName = GetINI("Fonts", "MonoName", "Arial")
        printer.FontSize = Val(GetINI("Fonts", "MonoSize", "12"))
        printer.FontBold = Val(GetINI("Fonts", "MonoBold", "-1"))
        printer.FontItalic = Val(GetINI("Fonts", "MonoItalic", "0"))
    Else
        fixedpitch = 0
        printer.FontName = GetINI("Fonts", "TextName", "Arial")
        printer.FontSize = Val(GetINI("Fonts", "TextSize", "12"))
        printer.FontBold = Val(GetINI("Fonts", "TextBold", "0"))
        printer.FontItalic = Val(GetINI("Fonts", "TextItalic", "0"))
    End If

    lineno = 0
    Max = GetNumLines() - firstline + 3

    While lineno <= Max
    If lineno > 2 Then
        textline = fixstr(GetLine(lineno + firstline - 3))
        If IsQuoted(textline) And Not fixedpitch Then
            If inquote = 0 Then
                inquote = 1
                printer.FontName = GetINI("Fonts", "QuoteName", "Arial")
                printer.FontSize = Val(GetINI("Fonts", "QuoteSize", "8"))
                printer.FontBold = Val(GetINI("Fonts", "QuoteBold", "0"))
                printer.FontItalic = Val(GetINI("Fonts", "QuoteItalic", "-1"))
            End If
        ElseIf inquote = 1 Then
            inquote = 0
            printer.FontName = GetINI("Fonts", "TextName", "Arial")
            printer.FontSize = Val(GetINI("Fonts", "TextSize", "12"))
            printer.FontBold = Val(GetINI("Fonts", "TextBold", "0"))
            printer.FontItalic = Val(GetINI("Fonts", "TextItalic", "0"))
        End If
        printer.Print leftmargin; textline
    ElseIf lineno = 0 Then
        ' Print pretty header stuff
        subject = fixstr(GetSubject(group, message))
        holdbold = printer.FontBold
        printer.FontBold = True
        printer.CurrentX = (printer.ScaleWidth - printer.TextWidth(subject)) / 2
        printer.Print subject
        printer.FontBold = holdbold
    ElseIf lineno = 1 Then
        author = fixstr(GetAuthor(group, message))
        author = " " + extractusername(author) + " "
        printer.Print author;
        organization = fixstr(GetHeader("Organization"))
        organization = " " + organization + " "
        printer.CurrentX = printer.ScaleWidth - printer.TextWidth(organization)
        printer.Print organization
    ElseIf lineno = 2 Then
        printer.Line -Step(printer.ScaleWidth, 0)
        printer.CurrentX = 0
    End If
    lineno = lineno + 1
    Wend
End If

printer.EndDoc
screen.MousePointer = default
End Sub

Sub mnugroups_Click ()
    dlgfile.FontName = lstareas.FontName
    dlgfile.FontSize = lstareas.FontSize
    dlgfile.DialogTitle = "Group Font"
    dlgfile.Flags = CF_SCREENFONTS
    On Error Resume Next
    dlgfile.Action = DLG_FONT
    If Err = 0 Then
        lstareas.FontName = dlgfile.FontName
        lstareas.FontSize = dlgfile.FontSize
    End If
End Sub

Sub mnuHAbout_Click ()
    frmabout.Show 1
End Sub

Sub mnumessage_Click ()
    dlgfile.FontName = GetINI("Fonts", "TextName", "Arial")
    dlgfile.FontSize = Val(GetINI("Fonts", "TextSize", "12"))
    dlgfile.FontBold = Val(GetINI("Fonts", "TextBold", "0"))
    dlgfile.FontItalic = Val(GetINI("Fonts", "TextItalic", "0"))
    dlgfile.Color = Val(GetINI("Fonts", "TextColor", pictext.ForeColor))
    dlgfile.DialogTitle = "Message Text Font"
    dlgfile.Flags = CF_SCREENFONTS + CF_EFFECTS
    On Error Resume Next
    dlgfile.Action = DLG_FONT
    If Err = 0 Then
        SetINI "Fonts", "TextName", dlgfile.FontName
        SetINI "Fonts", "TextSize", dlgfile.FontSize
        SetINI "Fonts", "TextBold", dlgfile.FontBold
        SetINI "Fonts", "TextItalic", dlgfile.FontItalic
        SetINI "Fonts", "TextColor", dlgfile.Color
        pictext_paint
    End If
End Sub

Sub mnumonofont_Click ()
    dlgfile.FontName = GetINI("Fonts", "MonoName", "Arial")
    dlgfile.FontSize = Val(GetINI("Fonts", "MonoSize", "12"))
    dlgfile.FontBold = Val(GetINI("Fonts", "MonoBold", "0"))
    dlgfile.FontItalic = Val(GetINI("Fonts", "MonoItalic", "0"))
    dlgfile.DialogTitle = "Monospaced Text Font"
    dlgfile.Flags = CF_SCREENFONTS Or CF_FIXEDPITCHONLY
    On Error Resume Next
    dlgfile.Action = DLG_FONT
    If Err = 0 Then
        SetINI "Fonts", "MonoName", dlgfile.FontName
        SetINI "Fonts", "MonoSize", dlgfile.FontSize
        SetINI "Fonts", "MonoBold", dlgfile.FontBold
        SetINI "Fonts", "MonoItalic", dlgfile.FontItalic
        pictext_paint
    End If

End Sub

Sub mnunewfolder_Click ()
Dim foldername As String

    foldername = InputBox$("Folder Name", "New Folder")
    CreateFolder (foldername)
    lstareas_click
End Sub

Sub mnunewmail_Click ()
    remember (0)
    mailreferences = ""
    mailsendto = ""
    mailsubject = ""
    replytype = 1
    MakeMessage
    remember (1)
End Sub

Sub mnuPostMsg_Click ()
    remember (0)
    mailsubject = ""
    mailreferences = ""
    mailsendto = fixstr(GetAreaName(group))
    replytype = 2
    MakeMessage
    remember (1)
End Sub

Sub mnuquote_Click ()
    dlgfile.FontName = GetINI("Fonts", "QuoteName", "Arial")
    dlgfile.FontSize = Val(GetINI("Fonts", "QuoteSize", "10"))
    dlgfile.FontBold = Val(GetINI("Fonts", "QuoteBold", "0"))
    dlgfile.FontItalic = Val(GetINI("Fonts", "QuoteItalic", "-1"))
    dlgfile.Color = Val(GetINI("Fonts", "QuoteColor", Format$(QBColor(8))))
    dlgfile.DialogTitle = "Quoted Text Font"
    dlgfile.Flags = CF_SCREENFONTS + CF_EFFECTS
    On Error Resume Next
    dlgfile.Action = DLG_FONT
    If Err = 0 Then
        SetINI "Fonts", "QuoteName", dlgfile.FontName
        SetINI "Fonts", "QuoteSize", dlgfile.FontSize
        SetINI "Fonts", "QuoteBold", dlgfile.FontBold
        SetINI "Fonts", "QuoteItalic", dlgfile.FontItalic
        SetINI "Fonts", "QuoteColor", dlgfile.Color
        pictext_paint
    End If

End Sub

Sub mnuration_Click ()
    frmratio.Show 1
    Form_resize
End Sub

Sub mnureplymail_Click ()
Dim subj As String

    remember (0)
    If Len(fixstr(GetHeader("Reply-To"))) > 2 Then
        mailsendto = fixstr(GetHeader("Reply-To"))
    Else
        mailsendto = fixstr(GetHeader("From"))
    End If
    subj = fixstr(GetHeader("Subject"))
    If Left$(subj, 4) <> "Re: " Then subj = "Re: " & subj
    mailsubject = subj
    mailreferences = fixstr(GetHeader("Message-ID")) + " " + fixstr(GetHeader("References"))
    replytype = 1
    MakeMessage
    remember (1)
End Sub

Sub mnurot13_Click ()
    Rot13Msg
    vsbtext_change
End Sub

Sub mnusave_Click ()
Dim Filename As String
Dim fileno, lineno As Integer

    remember (0)
    Filename = GetINI("Files", "Last Saved to", "NEWS.TXT")
    On Error Resume Next

    Err = 0
    dlgfile.Flags = OFN_NOREADONLYRETURN
    dlgfile.InitDir = app.Path
    'dlgfile.DefaultExt = "TXT"
    dlgfile.Filename = Filename
    dlgfile.Filter = "All Files (*.*)|*.*|Text Files (*.txt)|*.txt"
    dlgfile.DialogTitle = "Save Message To"
    dlgfile.Action = DLG_FILE_OPEN

    If dlgfile.Filename <> "" And Err = 0 Then
        screen.MousePointer = hourglass
        Filename = dlgfile.Filename
        SetINI "Files", "Last Saved to", Filename
        fileno = FreeFile
        Open Filename For Append As fileno
        GetMsg group, message
        For lineno = 1 To GetNumLines()
            Print #fileno, fixstr(GetLine(lineno))
        Next lineno
        Close fileno
        screen.MousePointer = default
    End If
    remember (1)
End Sub

Sub mnushowdocs_Click ()
Dim cmdstr As String
Dim fname As String
Dim x As Integer

    fname = app.Path + "\PAPERBOY.WRI"
    If fileexists(fname) Then
        cmdstr = "write " + fname
        x = Shell(cmdstr, 3)
    Else
        MsgBox "Couldn't find " + fname, MB_ICONEXCLAMATION, "Documentation File Not Found"
    End If
End Sub

Sub mnushowheaders_Click ()

    mnushowheaders.Checked = Not mnushowheaders.Checked
    If mnushowheaders.Checked Then
        SetINI "Display", "ShowHeaders", "Y"
    Else
        SetINI "Display", "ShowHeaders", "N"
    End If

    showmessages
End Sub

Sub mnushowlengths_Click ()
    mnushowlengths.Checked = Not mnushowlengths.Checked
    If mnushowlengths.Checked Then
        SetINI "Display", "ShowLengths", "Y"
    Else
        SetINI "Display", "ShowLengths", "N"
    End If

    remember (0)
    lstareas_click
    remember (1)
End Sub

Sub mnusubjects_Click ()
    dlgfile.FontName = lstsubjects.FontName
    dlgfile.FontSize = lstsubjects.FontSize
    dlgfile.DialogTitle = "Subjects Font"
    dlgfile.Flags = CF_SCREENFONTS
    On Error Resume Next
    dlgfile.Action = DLG_FONT
    If Err = 0 Then
        lstsubjects.FontName = dlgfile.FontName
        lstsubjects.FontSize = dlgfile.FontSize
    End If
End Sub

Sub mnuughbug_Click ()
    remember (0)
    mailreferences = ""
    mailsendto = "[e-mail]"
    mailsubject = "Paperboy " + PaperboyVersion + " Bug/Suggestion"
    replytype = 1
    MakeMessage
    remember (1)
End Sub

Sub pictext_paint ()
    If message > 0 Then vsbtext_change Else Call ShowSplash
End Sub

Sub remember (op As Integer) '0=push, 1=pop
Static grp As Integer
Static msg As Integer

    If op = 0 Then ' Push it
        grp = lstareas.ListIndex
        msg = lstsubjects.ListIndex
    ElseIf op = 1 Then 'Pop it
        If lstareas.ListIndex <> grp And grp < lstareas.ListCount Then lstareas.ListIndex = grp
        If lstsubjects.ListIndex <> msg And msg < lstsubjects.ListCount Then lstsubjects.ListIndex = msg
        If vsbtext.Enabled Then vsbtext.SetFocus
    End If
End Sub

Sub SetBackgrounds ()
Dim Bcolor As Long

    Bcolor = Val(GetINI("Display", "BackColor", Format$(WINDOW_BACKGROUND)))
    lstareas.BackColor = Bcolor
    lstsubjects.BackColor = Bcolor
    pictext.BackColor = Bcolor
    pictext_paint
End Sub

Sub showmessages ()
Dim firstline As Integer

    message = lstsubjects.ListIndex + 1
    If group = 0 Or message = 0 Then Exit Sub

    GetMsg group, message

    If GetNumLines() > 0 Then
        pictext.Enabled = True
        vsbtext.Enabled = True
        vsbtext.SetFocus
        EnableMsgMenus
        If fixstr(GetHeader("Followup-To")) = "poster" Then mnuFollowUp.Enabled = False
        If fixstr(GetHeader("Followup-To")) = "/dev/null" Then mnuFollowUp.Enabled = False
        vsbtext.Min = 0
        If mnushowheaders.Checked = True Then
            firstline = 1
        Else
            firstline = endofheaders()
        End If
        vsbtext.Max = GetNumLines() - firstline + 3
        ' Don't repaint twice
        If vsbtext.Value = vsbtext.Min Then vsbtext_change Else vsbtext.Value = vsbtext.Min
    End If
End Sub

Sub ShowSplash ()
Dim fonthold As Single
Dim fontcolor As Long
Dim showtext As String

    pictext.Cls
    pictext.FontName = GetINI("Fonts", "TextName", "Arial")
    pictext.FontSize = Val(GetINI("Fonts", "TextSize", "12"))
    pictext.FontBold = Val(GetINI("Fonts", "TextBold", "0"))
    pictext.FontItalic = Val(GetINI("Fonts", "TextItalic", "0"))
    fonthold = pictext.FontSize
    fontcolor = pictext.ForeColor
    pictext.FontSize = pictext.FontSize * 5
    pictext.CurrentY = (pictext.ScaleHeight - pictext.TextHeight("Paperboy")) / 2
    pictext.CurrentX = (pictext.ScaleWidth - pictext.TextWidth("Paperboy")) / 2
    pictext.ForeColor = BUTTON_SHADOW
    pictext.Print "Paperboy"
    pictext.CurrentX = (pictext.ScaleWidth - pictext.TextWidth("Paperboy")) / 2
    pictext.CurrentY = (pictext.ScaleHeight - pictext.TextHeight("Paperboy")) / 2
    pictext.CurrentX = pictext.CurrentX - pictext.TextWidth("Paperboy") / 200
    pictext.CurrentY = pictext.CurrentY - pictext.TextWidth("Paperboy") / 200
    pictext.ForeColor = BUTTON_FACE
    pictext.Print "Paperboy"
    pictext.FontSize = fonthold
    pictext.CurrentX = (pictext.ScaleWidth - pictext.TextWidth("Version " & PaperboyVersion)) / 2
    pictext.Print "Version " & PaperboyVersion
    showtext = "⌐ 1995 Michael H. Vartanian "
    pictext.CurrentY = pictext.ScaleHeight - pictext.TextHeight(showtext) * 2
    pictext.CurrentX = pictext.ScaleWidth - pictext.TextWidth(showtext)
    pictext.Print showtext
    showtext = "[e-mail] "
    pictext.CurrentY = pictext.ScaleHeight - pictext.TextHeight(showtext)
    pictext.CurrentX = pictext.ScaleWidth - pictext.TextWidth(showtext)
    pictext.Print showtext
    pictext.ForeColor = fontcolor
End Sub

Sub vsbtext_change ()
Dim lineno As Integer
Dim Max As Integer
Dim subject As String
Dim author As String
Dim organization As String
Dim textline As String
Dim inquote As Integer
Dim leftmargin As String
Dim fixedpitch As Integer
Dim holdbold As Integer
Dim firstline As Integer

inquote = 0
leftmargin = " "
pictext.Cls

If message > 0 Then
    If mnushowheaders.Checked = True Then
        firstline = 1
    Else
        firstline = endofheaders()
    End If

    If mnufixedpitch.Checked = True Then
        fixedpitch = 1
        pictext.FontName = GetINI("Fonts", "MonoName", "Courier New")
        pictext.FontSize = Val(GetINI("Fonts", "MonoSize", "12"))
        pictext.FontBold = Val(GetINI("Fonts", "MonoBold", "-1"))
        pictext.FontItalic = Val(GetINI("Fonts", "MonoItalic", "0"))
    Else
        fixedpitch = 0
        pictext.FontName = GetINI("Fonts", "TextName", "Arial")
        pictext.FontSize = Val(GetINI("Fonts", "TextSize", "12"))
        pictext.FontBold = Val(GetINI("Fonts", "TextBold", "0"))
        pictext.FontItalic = Val(GetINI("Fonts", "TextItalic", "0"))
        pictext.ForeColor = Val(GetINI("Fonts", "TextColor", pictext.ForeColor))
    End If

    lineno = vsbtext.Value
    Max = GetNumLines() - firstline + 3

    While lineno <= Max And pictext.CurrentY <= pictext.ScaleHeight
    If lineno > 2 Then
        textline = fixstr(GetLine(lineno + firstline - 3))
        If IsQuoted(textline) And Not fixedpitch Then
            If inquote = 0 Then
                inquote = 1
                pictext.FontName = GetINI("Fonts", "QuoteName", "Arial")
                pictext.FontSize = Val(GetINI("Fonts", "QuoteSize", "10"))
                pictext.FontBold = Val(GetINI("Fonts", "QuoteBold", "0"))
                pictext.FontItalic = Val(GetINI("Fonts", "QuoteItalic", "-1"))
                pictext.ForeColor = Val(GetINI("Fonts", "QuoteColor", Format$(QBColor(8))))
            End If
        ElseIf inquote = 1 Then
            inquote = 0
            pictext.FontName = GetINI("Fonts", "TextName", "Arial")
            pictext.FontSize = Val(GetINI("Fonts", "TextSize", "12"))
            pictext.FontBold = Val(GetINI("Fonts", "TextBold", "0"))
            pictext.FontItalic = Val(GetINI("Fonts", "TextItalic", "0"))
            pictext.ForeColor = Val(GetINI("Fonts", "TextColor", pictext.ForeColor))
        End If
        pictext.Print leftmargin; textline
    ElseIf lineno = 0 Then
        ' Print pretty header stuff
        subject = fixstr(GetSubject(group, message))
        holdbold = pictext.FontBold
        pictext.FontBold = True
        pictext.CurrentX = (pictext.ScaleWidth - pictext.TextWidth(subject)) / 2
        pictext.Print subject
        pictext.FontBold = holdbold
    ElseIf lineno = 1 Then
        author = fixstr(GetAuthor(group, message))
        author = " " + extractusername(author) + " "
        pictext.Print author;
        organization = fixstr(GetHeader("Organization"))
        organization = " " + organization + " "
        pictext.CurrentX = pictext.ScaleWidth - pictext.TextWidth(organization)
        pictext.Print organization
    ElseIf lineno = 2 Then
        pictext.Line -Step(pictext.ScaleWidth, 0)
        pictext.CurrentX = 0
    End If
    lineno = lineno + 1
    Wend
    ' Calculate what a page is
    If pictext.CurrentY <= pictext.ScaleHeight Then
    'If lineno > Max Then
        ' we bottomed out
        'vsbtext.LargeChange = 1
        vsbtext.Max = vsbtext.Value 'Bottom out the scrollbar
        'vsbtext.Value = vsbtext.Max
    Else ' how much to get to next page
        holdbold = lineno - vsbtext.Value - 1
        If holdbold > 0 Then vsbtext.LargeChange = holdbold
    End If
End If
End Sub

Sub vsbtext_KeyPress (keyascii As Integer)
    If message > 0 Then
        If keyascii = 32 Then
            'space pressed
            If vsbtext.Value >= vsbtext.Max Then
                If lstsubjects.ListIndex >= (lstsubjects.ListCount - 1) Then
                    'Next group
                    If lstareas.ListIndex < (lstareas.ListCount - 1) Then
                            lstareas.ListIndex = lstareas.ListIndex + 1
                            If lstsubjects.ListCount > 0 Then lstsubjects.ListIndex = 0
                    Else
                            'Do nothing (end of groups)
                            lstareas.ListIndex = lstareas.ListIndex
                    End If
                Else
                    'Next message
                    lstsubjects.ListIndex = lstsubjects.ListIndex + 1
                End If
            Else
                ' Page down
                If vsbtext.Value + vsbtext.LargeChange >= vsbtext.Max Then vsbtext.Value = vsbtext.Max Else vsbtext.Value = vsbtext.Value + vsbtext.LargeChange
            End If
        End If 'space

        If keyascii = Asc("n") Or keyascii = Asc("N") Then
            ' Next message
            If lstsubjects.ListIndex >= (lstsubjects.ListCount - 1) Then
                'Next group
                If lstareas.ListIndex < (lstareas.ListCount - 1) Then
                        lstareas.ListIndex = lstareas.ListIndex + 1
                        If lstsubjects.ListCount > 0 Then lstsubjects.ListIndex = 0
                Else
                        'Do nothing (end of groups)
                        lstareas.ListIndex = lstareas.ListIndex
                End If
            Else
                'Next message
                lstsubjects.ListIndex = lstsubjects.ListIndex + 1
            End If
        End If ' N or n

        If keyascii = Asc("p") Or keyascii = Asc("P") Then
            ' Previous message
            If lstsubjects.ListIndex > 0 Then lstsubjects.ListIndex = lstsubjects.ListIndex - 1
        End If ' P or p
    End If ' message > 0
End Sub

Sub vsbtext_Scroll ()
    vsbtext_change
End Sub